home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / com / computer / sernet / anetwork.mod < prev    next >
Text File  |  1993-09-24  |  31KB  |  902 lines
  1. MODULE NETWORK ;
  2.  
  3. (* --------------------------------------------------------------------------
  4.  
  5.                NETWORK : RS-232 TWO CPU NETWORK FOR TDI Modula-2/ST
  6.  
  7.    --------------------------------------------------------------------------*)
  8.  
  9. (*$T- *)  (*$S- *)
  10.  
  11.  
  12. FROM SYSTEM IMPORT ADDRESS, ADR, SETREG, CODE, REGISTER ,BYTE ,TSIZE,SIZE;
  13. FROM GEMX   IMPORT BasePageAddress, BasePageType ;
  14. FROM BIOS   IMPORT BPB ,BConStat ,BConIn, BCosStat, BConOut, Device,
  15.                    MediaChange,MCState,GetBPB,RWAbs,RW,DriveSet,DriveMap;
  16. FROM XBIOS  IMPORT SuperExec,ConfigureRS232,SerialSpeed,FlowFlavor,
  17.                    SerialDevice,IORec,IORECPTR,IOREC,VSync;
  18. FROM GEMDOS IMPORT TermRes,Open,Close ;
  19. IMPORT             GEMDOS;
  20. FROM ASCII  IMPORT SYN,STX,SOH;
  21.  
  22. CONST
  23.   MaxSeq          = 1;
  24.   recsize         = 511;
  25.   USER            = 324159265;
  26.   retry           = 5;
  27.   debug           = FALSE;
  28.   trace           = FALSE;
  29.  
  30.   (* Because we dont know what registers the BIOS is using we must use
  31.      the following opcodes to save the registers *)
  32.   MOVEMDEC = 48E7H ;    (* 68000 opcode for MOVEM <regs>,-(A7) *)
  33.   MOVEMINC = 4CDFH ;    (* 68000 opcode for MOVEM (A7)+,<regs> *)
  34.   SAVEREGS = 07FFCH ;   (* Registers D1..A5 for DEC *)
  35.   RESTREGS = 03FFEH ;   (* Registers D1..A5 for INC *)
  36.   RTS = 04E75H ;        (* 68000 return from subroutine opcode *)
  37.  
  38. TYPE
  39.   (* Procedure types to mimic correct sequence for "C" BIOS routines *)
  40.  
  41.   CBPBProc     = PROCEDURE ( CARDINAL ) ;
  42.   CMediaChProc = PROCEDURE ( CARDINAL ) ;
  43.   CRWAbsProc   = PROCEDURE ( CARDINAL, CARDINAL, CARDINAL, ADDRESS, CARDINAL );
  44.   rs232buffer  = ARRAY [0..512] OF CARDINAL;
  45.   SequenceNr   = [0..MaxSeq];
  46.   message      = ARRAY [0..recsize] OF BYTE;
  47.   message1     = ARRAY [0..17] OF BYTE;
  48.   FrameKind    = (ack,data,callreq,callaccp,clearreq,clearconf,
  49.                  resetreq,resetconf,diag);
  50.   DataKind     = (rdmediareq,rdmediaconf,rdbpbreq,rdbpbconf,
  51.                  rdrwabsreq,rdrwabsconf);
  52.   evtype       = (framearrival,cksumerr,timeout,hostready,reset,nothing);
  53.  
  54.   frame        = RECORD
  55.                  syn    :       CHAR; (* these are sync chars *)
  56.                  stx    :       CHAR; (* for the frames       *)
  57.                  kind   :       FrameKind;
  58.                  seq    :       SequenceNr;
  59.                  ack    :       SequenceNr;
  60.                  cmd    :       DataKind;
  61.                  rw     :       CARDINAL; (* read or write data *)
  62.                  recno  :       CARDINAL; (* sector for data*)
  63.                  d0     :       LONGCARD; (* data return variable *)
  64.                  info   :       message;
  65.                  user   :       LONGCARD;
  66.                  cksum  :       CARDINAL;
  67.                END;
  68.  
  69.   framecptr    = POINTER TO framecmd;
  70.   framecmd     = RECORD
  71.                  syn    :       CHAR; (* these are sync chars *)
  72.                  stx    :       CHAR; (* for the frames       *)
  73.                  kind   :       FrameKind;
  74.                  seq    :       SequenceNr;
  75.                  ack    :       SequenceNr;
  76.                  cmd    :       DataKind;
  77.                  rw     :       CARDINAL; (* read or write data *)
  78.                  recno  :       CARDINAL; (* sector for data*)
  79.                  d0     :       LONGCARD; (* data return variable *)
  80.                  info   :       message1;
  81.                  user   :       LONGCARD;
  82.                  cksum  :       CARDINAL;
  83.                END;
  84.  
  85.   control     = RECORD
  86.                  magic          :       LONGCARD;
  87.                  speed          :       SerialSpeed;
  88.                  reset          :       BOOLEAN;
  89.                  networkactive  :       BOOLEAN;
  90.                  remotedrive    :       CARDINAL;
  91.                  drivemap       :       DriveSet;
  92.                 nextframetosend :      SequenceNr;
  93.                 frameexpected   :      SequenceNr;
  94.                 sendreset       :      BOOLEAN;
  95.                END;
  96.  
  97.   consave     = RECORD
  98.                  magic          :       LONGCARD;
  99.                  speed          :       SerialSpeed;
  100.                  reset          :       BOOLEAN;
  101.                  networkactive  :       BOOLEAN;
  102.                 END;
  103.  
  104.   vblqueueptr   =       POINTER TO ADDRESS;
  105.   frameptr      =       POINTER TO ARRAY [0..1024] OF BYTE;
  106.  
  107. VAR
  108.  
  109.  
  110.   (* BIOS variables : These can only be accessed with the 68000 in supervisor
  111.      mode. The Modula-2 language allows you to fix the location of variables *)
  112.  
  113.   HDBPB     [0472H] : ADDRESS ;       (* hard disk get Bios Parameter Block *)
  114.   HDRWAbs   [0476H] : ADDRESS ;       (* hard disk read/write abs   *)
  115.   HDMediaCh [047EH] : ADDRESS ;       (* hard disk media change     *)
  116.   DriveBits [04C2H] : SET OF [0..31]; (* disk drives present map    *)
  117.   RS232RBF  [0130H] : ADDRESS ;       (* 232 rec char vector        *)
  118.   vblsem    [0452H] : CARDINAL;       (* check for vbl's enable     *)
  119.   flock     [043EH] : LONGCARD;       (* disk access in progress    *)
  120.   Cptr      [0200H] : ADDRESS;
  121.   Dptr      [0204H] : DriveSet;       (* save original drive map    *)
  122.   Mptr      [0208H] : LONGCARD;
  123.   charcount,j,framesize,cksum,recframesize,sndframesize,
  124.   SIZEframe,SIZEframecmd                                : CARDINAL;
  125.   vblqueue          : vblqueueptr;    (* set to vbl routines vector *)
  126.   vblptr            : vblqueueptr;
  127.  
  128.   networkconnect          :   BOOLEAN; (* DCD = 1 TRUE  *)
  129.   gotframe                :   BOOLEAN;
  130.   framebufferfull         :   BOOLEAN;
  131.   cleartosend             :   BOOLEAN;
  132.   readytosend             :   BOOLEAN;
  133.   requesttosend           :   BOOLEAN;
  134.   framewaiting            :   BOOLEAN;
  135.   timer,OK                :   BOOLEAN;
  136.   gotmediach              :   ARRAY [0..5] OF BOOLEAN;
  137.   gotbpb                  :   ARRAY [0..5] OF BOOLEAN;
  138.   vblactive               :   BOOLEAN;
  139.   networkerror            :   BOOLEAN;
  140.   shortframe              :   BOOLEAN;
  141.   sendlong                :   BOOLEAN;
  142.  
  143.   sframe,rframe,SFRAME,RFRAME,
  144.   nframe1,nframe2                  :   frame;
  145.   rframeptr,sframeptr,
  146.   bpbptr,nbpbptr                   :   frameptr;
  147.   framecmdptr,framecmdptr1         :   framecptr;
  148.   event                            :   evtype;
  149.   C                                :   control;
  150.   recchar,timestart,timefortimeout,timeouttime :   LONGCARD;
  151.   timestart1,timefortimeout1,timeouttime1      :   LONGCARD;
  152.   result,r,i,i1,i2,i3,mediacount,handle        :   INTEGER;
  153.   D0ptr                                        :   POINTER TO LONGCARD;
  154.   wsector,drvnr,DriveA,DriveF,devicestart,d,R  :   CARDINAL;
  155.   sbuffer,rbuffer                              :   rs232buffer;
  156.   sbptr,rbptr                                  :   IORECPTR;
  157.   numBytes,sec,min,hour,time,count             :   LONGCARD ;
  158.   status                                       :   LONGINT ;
  159.  
  160.   (* The following are saved copies of the BIOS variables so that the real
  161.      hard disk routines can be called if a hard disk access is requested. *)
  162.  
  163.   SaveHDBPB      : CBPBProc ;     (* hard disk get Bios Parameter Block *)
  164.   SaveHDRWAbs    : CRWAbsProc ;   (* hard disk read/write abs *)
  165.   SaveHDMediaCh  : CMediaChProc ; (* hard disk media change *)
  166.  
  167.   (* NETWORK control *)
  168.  
  169.   NetworkBPB  : ARRAY [0..5] OF BPB ; (* BIOS Parameter block for NETWORK *)
  170.  
  171. PROCEDURE MoveMemory ( From, To : ADDRESS ; Bytes : LONGCARD ) ;
  172. (* This routine shows how time critical portions of code can be optimised to
  173.    run faster. It relys on the code generation rules of the compiler which 
  174.    can be checked by dis-assembling the link file with DecLnk.*)
  175.  
  176. CONST
  177.   MOVEB = 12D8H ;       (*      MOVE.B  (A0)+,(A1)+     *)
  178.   MOVEL = 22D8H ;       (*      MOVE.L  (A0)+,(A1)+     *)
  179.   A0    = 0+8 ;         (* register A0 *)
  180.   A1    = 1+8 ;         (* register A1 *)
  181.  
  182. BEGIN
  183.   SETREG(A0,From) ;             (* load From pointer into A0 *)
  184.   SETREG(A1,To) ;               (* load To pointer into A1 *)
  185.   
  186.   IF ( ODD(From) OR ODD(To) ) THEN      (* must do bytes *)
  187.     WHILE ( Bytes <> 0 ) DO
  188.       CODE(MOVEB) ;
  189.       DEC(Bytes) ;
  190.     END ;
  191.   ELSE (* even addresses so can do long moves *)
  192.     WHILE ( Bytes > 3 ) DO
  193.       CODE(MOVEL) ;
  194.       DEC(Bytes,4) ;
  195.     END ;
  196.     WHILE ( Bytes <> 0 ) DO
  197.       CODE(MOVEB) ;             (* clean up remainder *)
  198.       DEC(Bytes) ;
  199.     END ;
  200.   END ;
  201. END MoveMemory ;
  202.  
  203.  
  204. PROCEDURE inc(VAR k: SequenceNr);   (* increment k circulary *)
  205. BEGIN
  206.         IF k<MaxSeq THEN k:=k+1 ELSE k:=0 END;
  207. END     inc;
  208.  
  209.  
  210. (* The following procedures mimic the disk handling routines called by the
  211.    BIOS. Their procedure declarations have been written to mimic the "C"
  212.    calling sequence. *)
  213.  
  214. PROCEDURE RDRWAbs ( device, RecordNum, SectorCount : CARDINAL ;
  215.                     Buffer : ADDRESS ; Flag : CARDINAL ) ;
  216. (* NB. It is assumed that GEMDOS wont call this routine with out of range
  217.    parameters *)
  218. CONST D0 = 0 ;
  219. BEGIN
  220.   CODE(MOVEMDEC,SAVEREGS) ;     (* save registers on stack *)
  221.   status := 0;
  222.   IF (device >= DriveA) AND (device <=DriveF) THEN (* is NETWORK channel *)
  223.     IF ( Flag = 0 ) OR ( Flag = 2 ) (* read *)  THEN
  224.        FOR wsector:=0 TO (SectorCount-1) DO
  225.            C.remotedrive:=device-devicestart; 
  226.            nframe1.d0:=LONGCARD(device-devicestart);
  227.            nframe1.recno:=RecordNum+wsector;
  228.            nframe1.rw:=Flag; (* read *)
  229.            resetnewdisk;
  230.            IF getfromremote(rdrwabsreq,rdrwabsconf,nframe1) THEN
  231.               MoveMemory(ADR(nframe1.info),Buffer+ADDRESS(wsector)*512,
  232.                          512);
  233.               status:=0;
  234.            ELSE
  235.               status:=(-11);
  236.            END; (* if *)
  237.        END; (* for *)
  238.     IF networkerror THEN C.sendreset:=TRUE END; (* send network reset to remote cpu *)
  239.       SETREG(D0,status) ;
  240.     ELSIF ( Flag = 1 ) OR ( Flag = 3 ) THEN (* write *)
  241.        FOR wsector:=0 TO (SectorCount-1) DO
  242.            C.remotedrive:=device-devicestart; 
  243.            nframe1.d0:=LONGCARD(device-devicestart);
  244.            nframe1.recno:=RecordNum+wsector;
  245.            nframe1.rw:=Flag; (* write *)
  246.            resetnewdisk;
  247.            MoveMemory(Buffer+ADDRESS(wsector)*512,ADR(nframe1.info),512);
  248.            IF getfromremote(rdrwabsreq,rdrwabsconf,nframe1) THEN
  249.               status:=0;
  250.            ELSE
  251.               status:=(-10);
  252.            END;
  253.        END; (* for *)
  254.     IF networkerror THEN C.sendreset:=TRUE END; (* send network reset to remote cpu *)
  255.       SETREG(D0,status) ;
  256.     ELSE
  257.       SETREG(D0,LONGINT(-3)) ;
  258.     END ;
  259.   ELSE (* not NETWORK *)
  260.     SaveHDRWAbs (device,RecordNum,SectorCount,Buffer,Flag) ;
  261.   END ;
  262.   CODE(MOVEMINC,RESTREGS) ;     (* Restore registers from stack *)
  263. END RDRWAbs ;
  264.  
  265. PROCEDURE RDMediaCh ( device : CARDINAL ) ;
  266. CONST D0 = 0 ;
  267. BEGIN
  268.   CODE(MOVEMDEC,SAVEREGS) ;     (* save registers on stack *)
  269.   IF (device >= DriveA) AND (device <=DriveF) THEN (* is NETWORK channel *)
  270.     C.remotedrive:=device-devicestart; 
  271.     nframe1.d0:=LONGCARD(device-devicestart);
  272.     IF newdisk() THEN
  273.        gotmediach[device-devicestart]:=FALSE;
  274.        gotbpb[device-devicestart]:=FALSE;
  275.     END;
  276.     IF (NOT gotmediach[device-devicestart]) THEN
  277.      IF getfromremote(rdmediareq,rdmediaconf,nframe1) THEN 
  278.         gotmediach[device-devicestart]:=TRUE;
  279.         IF nframe1.d0=1 THEN nframe1.d0:=2 END;
  280.         SETREG(D0,nframe1.d0) ;    (* "C" uses D0 as return location *)
  281.      ELSE
  282.         SETREG(D0,Changed);
  283.      END;
  284.     ELSE
  285.        SETREG(D0,NoChange) ;    (* "C" uses D0 as return location *)
  286.     END; 
  287.   ELSE (* not NETWORK *)
  288.     SaveHDMediaCh(device) ;
  289.   END;
  290.   CODE(MOVEMINC,RESTREGS) ;     (* Restore registers from stack *)
  291. END RDMediaCh ;
  292.  
  293. PROCEDURE RDBPB ( device : CARDINAL ) ;
  294. CONST D0 = 0 ;
  295. BEGIN
  296.   CODE(MOVEMDEC,SAVEREGS) ;     (* save registers on stack *)
  297.   IF (device >= DriveA) AND (device <=DriveF) THEN (* is NETWORK channel *)
  298.     C.remotedrive:=device-devicestart; 
  299.     nframe1.d0:=LONGCARD(device-devicestart);
  300.     IF newdisk() THEN gotbpb[device-devicestart]:=FALSE; gotmediach[device-devicestart]:=FALSE END;
  301. (*       gotbpb[device-devicestart]:=FALSE;   (* test *) *)
  302.     IF (NOT gotbpb[device-devicestart]) THEN
  303.      IF getfromremote(rdbpbreq,rdbpbconf,nframe1) THEN 
  304.        gotbpb[device-devicestart]:=TRUE;
  305.        bpbptr:=ADR(nframe1.info);
  306.        nbpbptr:=ADR(NetworkBPB[device-devicestart]);
  307.        FOR i3:=0 TO TSIZE(BPB)-1 DO
  308.            nbpbptr^[i3]:=bpbptr^[i3];    
  309.        END;
  310.        resetnewdisk;
  311.        SETREG(D0,ADR(NetworkBPB[device-devicestart])); (* D0 returns address of the BPB *)
  312.      ELSE
  313.        SETREG(D0,0);
  314.      END;
  315.     ELSE
  316.        SETREG(D0,ADR(NetworkBPB[device-devicestart])); (* D0 returns address of the BPB *)
  317.     END; 
  318.     IF networkerror THEN C.sendreset:=TRUE END; (* send network reset to remote cpu *)
  319.   ELSE (* not NETWORK *)
  320.     SaveHDBPB(device) ;
  321.   END ;
  322.   CODE(MOVEMINC,RESTREGS) ;     (* Restore registers from stack *)
  323. END RDBPB ;
  324.     
  325. PROCEDURE resetnewdisk;
  326. BEGIN
  327.         CODE(3f3cH,0017H,4e4eH,548fH); (* gettime *)
  328.         timestart1:=LONGCARD(REGISTER(0));
  329.         timefortimeout1:=timestart1;
  330.         IncTime(timefortimeout1,3+CARDINAL(C.speed));
  331. END     resetnewdisk;
  332.  
  333. PROCEDURE newdisk(): BOOLEAN;
  334. BEGIN
  335.         CODE(3f3cH,0017H,4e4eH,548fH); (* gettime *)
  336.         timeouttime1:=LONGCARD(REGISTER(0));
  337.         SETREG(0,timeouttime1);
  338.         CODE(0280H,0,0FFFFH);
  339.         timeouttime1:=LONGCARD(REGISTER(0));
  340.         IF timeouttime1>timefortimeout1 THEN
  341.            resetnewdisk;
  342.            RETURN TRUE;
  343.         END;
  344.         RETURN FALSE;
  345. END     newdisk;
  346.  
  347. (* ----------------------------------------------------------------------- *)
  348.  
  349. PROCEDURE Initialise () : BOOLEAN ;
  350. (* returns TRUE if NETWORK is to be installed *)
  351. BEGIN
  352.   CODE(3f3cH,0017H,4e4eH,548fH);           (* gettime *)
  353.   CODE(2f00H,3f3cH,0016H,4e4eH,5c8fH);     (* settime *)
  354.   SuperExec(PROC(setcontrol));   (* set address of global control record *)
  355.   rbptr:=IORec(RS232);
  356.   sbptr:=IORECPTR(LONGCARD(rbptr)+LONGCARD(14));
  357.   rbptr^.ibuf:=ADR(rbuffer);
  358.   rbptr^.ibufsize:=1024;
  359.   sbptr^.ibuf:=ADR(sbuffer);
  360.   sbptr^.ibufsize:=1024;
  361.   C.magic:=USER;
  362.   C.remotedrive:=0;
  363.   C.speed:=BPS1200;
  364.   ConfigureRS232(C.speed,NONE,136,-1,-1,-1);
  365.   framesize:=TSIZE(frame);
  366.   recframesize:=framesize;
  367.   sndframesize:=framesize;
  368.   sframe.user:=USER;
  369.   R:=0;
  370.   RETURN TRUE;
  371. END Initialise ;
  372.  
  373. (*$P- *) (* set vector to control record *)
  374. PROCEDURE setcontrol;
  375. BEGIN
  376.         Cptr:=ADR(C);
  377.         IF Mptr#USER THEN
  378.            C.drivemap:=DriveMap();
  379.            Dptr:=C.drivemap;
  380.         END;
  381.         C.drivemap:=Dptr;
  382.         Mptr:=USER;
  383.         CODE(RTS);
  384. END     setcontrol;
  385.  
  386. (*      this routine reads the 232 port data and sync's it into frames  *)
  387. (*      it runs as a background process in a vbl time slot              *)
  388. (*$P- *)
  389. PROCEDURE recframe; 
  390. BEGIN
  391.         IF C.networkactive AND vblactive THEN
  392.            CODE(02f39H,0,04a2H); (* move.l $4a2,-(sp) save BIOS pointer *)
  393.            CODE(04b9H,0,02eH,0,04a2H); (* sub 46 from pointer *)
  394.            nrecframe;
  395.            Nwait(event);
  396.            HandleEvents();
  397.            CODE(023dfH,0,04a2H); (* restore BIOS pointer *)
  398.         END;
  399.         CODE(RTS);
  400. END     recframe;
  401.  
  402. PROCEDURE nrecframe; 
  403. BEGIN
  404.         IF C.networkactive THEN
  405.            WHILE (BConStat(AUX)) AND (NOT framebufferfull) DO
  406.                  recchar := BConIn(AUX);
  407.                  IF (recchar=LONGCARD(SYN)) AND (NOT gotframe) THEN
  408.                     gotframe:=TRUE; (* got sync char from data *)
  409.                     charcount:=0;
  410.                  END;
  411.                  IF (charcount=1) AND ((recchar#LONGCARD(STX)) AND (recchar#LONGCARD(SOH))) THEN
  412.                     gotframe:=FALSE; (* false start try again *)
  413.                     charcount:=0;
  414.                  END;
  415.                  IF (charcount=1) AND (recchar=LONGCARD(STX)) THEN
  416.                     recframesize:=SIZEframe;
  417.                  END;
  418.                  IF (charcount=1) AND (recchar=LONGCARD(SOH)) THEN
  419.                     recframesize:=SIZEframecmd;
  420.                  END;
  421.                  IF gotframe THEN                  (* put data in buffer *)
  422.                     rframeptr^[charcount]:=BYTE(recchar);
  423.                     INC(charcount);
  424.                     IF charcount=recframesize THEN (* got full frame *)
  425.                        gotframe := FALSE;
  426.                        IF recframesize=SIZEframecmd THEN
  427.                           rframe.user:=framecmdptr^.user;
  428.                           rframe.cksum:=framecmdptr^.cksum;
  429.                        END;
  430.                        framebufferfull := TRUE;
  431.                     END;
  432.                  END;
  433.            END; (* WHILE *)
  434.         END;
  435. END     nrecframe;
  436.  
  437. (* The following compiler directive stops the compiler from generating the
  438.    normal Modula-2 entry/exit code for the next procedure. This is needed as
  439.    this routine is called in supervisor mode by the BIOS function to install
  440.    the BIOS vectors. *)
  441. (*$P- Stop entry/exit code for next procedure *)
  442. PROCEDURE InstallVectors ;
  443. BEGIN
  444.   (* First save the current hard disk vectors *)
  445.   SaveHDBPB := CBPBProc(HDBPB) ;
  446.   SaveHDRWAbs := CRWAbsProc(HDRWAbs) ;
  447.   SaveHDMediaCh := CMediaChProc(HDMediaCh) ;
  448.   (* Now set the BIOS vectors to our routines *)
  449.   HDBPB := ADDRESS(RDBPB) ;
  450.   HDRWAbs := ADDRESS(RDRWAbs) ;
  451.   HDMediaCh := ADDRESS(RDMediaCh) ;
  452.   drvnr:=2;
  453.   WHILE drvnr IN DriveBits DO
  454.         INC(drvnr);
  455.   END; (* while *)
  456.   INC(drvnr);
  457.   devicestart:=drvnr;
  458.   DriveA:=drvnr;
  459.   DriveF:=drvnr+5;
  460.   INCL(DriveBits,drvnr) ;             (* set new drive A *)
  461.   INCL(DriveBits,drvnr+1) ;           (* set new drive B *)
  462.   INCL(DriveBits,drvnr+2) ;           (* set new drive C *)
  463.   INCL(DriveBits,drvnr+3) ;           (* set new drive D *)
  464.   INCL(DriveBits,drvnr+4) ;           (* set new drive E *)
  465.   INCL(DriveBits,drvnr+5) ;           (* set new drive F *)
  466.   networkconnect := FALSE;
  467.   vblactive:=TRUE;
  468.   gotframe := FALSE;
  469.   framebufferfull := FALSE;
  470.   charcount:=0;
  471.   SIZEframe:=TSIZE(frame);
  472.   SIZEframecmd:=TSIZE(framecmd);
  473.  
  474. (*  vblsem:=0; *)
  475.   vblqueue := vblqueueptr(0456H);
  476.   vblptr := vblqueue^; (* set to address of vbls *)
  477.   rframeptr := ADR(rframe);
  478.   framecmdptr:=ADR(rframe);
  479.   sframeptr := ADR(sframe);
  480.   LOOP         (* set up vbl vector to make packet frame from 232 input *)
  481.         IF vblptr^ =  ADDRESS(0) THEN
  482.            vblptr^ := ADDRESS(recframe);
  483.            EXIT;
  484.         ELSE
  485.    (*$T-*) INC(vblptr,4) ; (*$T=*)
  486.         END;
  487.   END; (* LOOP *)
  488. (*  vblsem:=1; *)
  489.   CODE(RTS) ;                (* code to return to calling BIOS function *)
  490. END InstallVectors ;
  491.  
  492. (*$P+ *)
  493. PROCEDURE sendf(VAR f: frame);
  494. BEGIN
  495.         sframe:=f;
  496.         sframe.cksum:=0;
  497.         IF ((sframe.cmd=rdrwabsconf) AND ((sframe.rw=0) OR (sframe.rw=2))) OR ((sframe.cmd=rdrwabsreq) AND ((sframe.rw=1) OR (sframe.rw=3))) THEN
  498.            sndframesize:=SIZEframe;
  499.            sframe.syn :=  SYN ;
  500.            sframe.stx :=  STX ;
  501.            sframe.user := USER ;
  502.            shortframe:=FALSE;
  503.         IF trace THEN BConOut(CON,":") END;
  504.         ELSE
  505.            sndframesize:=SIZEframecmd;
  506.            sframe.syn := SYN ;
  507.            sframe.stx := SOH ;
  508.            framecmdptr1:=ADR(sframe);
  509.            framecmdptr1^.user := USER ;
  510.            shortframe:=TRUE;
  511.         IF trace THEN BConOut(CON,".") END;
  512.         END;
  513.         FOR i1:=0 TO sndframesize-5 DO (* compute checksum *)
  514.             sframe.cksum:=sframe.cksum+CARDINAL(sframeptr^[i1])
  515.         END;
  516.         IF shortframe THEN framecmdptr1^.cksum:=sframe.cksum END;
  517.         FOR i1:=0 TO sndframesize-1 DO (* send frame *)
  518.             REPEAT
  519.               nrecframe;
  520.             UNTIL BCosStat(AUX); 
  521.             BConOut(AUX,CHAR(sframeptr^[i1]));
  522.         END;
  523.         REPEAT
  524.         UNTIL sbptr^.ibufhd=sbptr^.ibuftl;
  525. END     sendf;
  526.  
  527. PROCEDURE getf(VAR f: frame);
  528. BEGIN
  529.         f:=rframe;
  530.         framebufferfull:=FALSE;
  531. END     getf;
  532.  
  533. PROCEDURE waitcts(what: BOOLEAN); (* wait for cleartosend state *)
  534. BEGIN
  535.         IF what THEN
  536.            REPEAT
  537.            nrecframe;
  538.            Nwait(event);
  539.            HandleEvents(); 
  540.            IF R>retry THEN
  541.               networkerror:=TRUE;
  542.               RETURN; (* trouble *)
  543.            END;
  544.            UNTIL cleartosend;
  545.            RETURN;
  546.         ELSE
  547.            LOOP
  548.            nrecframe;
  549.            Nwait(event);
  550.            IF (NOT cleartosend) THEN EXIT END;
  551.            HandleEvents();
  552.            IF R>retry THEN
  553.               networkerror:=TRUE;
  554.               RETURN; (* trouble *)
  555.            END;
  556.            END; (* loop *)
  557.         IF trace THEN BConOut(CON,"N") END;
  558.            HandleEvents(); 
  559.         END;
  560. END     waitcts;
  561.  
  562. (* request for data from remote hosts disk drives and system *)
  563. (* what wanted in command, the correct reply in reply, data in f *)
  564. PROCEDURE getfromremote(command, reply: DataKind; VAR f: frame): BOOLEAN;
  565. BEGIN
  566.         IF (NOT C.networkactive) THEN RETURN FALSE END; (* error *)
  567.         networkerror:=FALSE;
  568.         R:=0;
  569.         StartTimer;
  570.         vblactive:=FALSE;
  571.         IF trace THEN BConOut(CON,"A") END;
  572.         f.kind:=data;
  573.         f.cmd:=command;
  574.         waitcts(TRUE);
  575.         IF networkerror THEN RETURN FALSE END;
  576.         IF trace THEN BConOut(CON,"B") END;
  577.         SFRAME:=f;
  578.         requesttosend:=TRUE;
  579.         waitcts(FALSE); 
  580.         IF networkerror THEN RETURN FALSE END;
  581.         IF trace THEN BConOut(CON,"C") END;
  582.         REPEAT  
  583.         nrecframe;
  584.         Nwait(event);
  585.         HandleEvents(); 
  586.         IF R>retry THEN networkerror:=TRUE END;
  587.         IF networkerror THEN RETURN FALSE END;
  588.         UNTIL framewaiting AND (RFRAME.cmd=reply);
  589.         IF trace THEN BConOut(CON,"D") END;
  590.         f:=RFRAME;
  591.         f.rw:=5;
  592.         framewaiting:=FALSE;
  593.         sendtoremote(ack,reply,f); (* send ack for reply *)
  594.         IF networkerror THEN RETURN FALSE END;
  595.         IF trace THEN BConOut(CON,"Z") END;
  596.         vblactive:=TRUE;
  597.         VSync;
  598.         RETURN TRUE;
  599. END     getfromremote;
  600.  
  601. PROCEDURE sendtoremote(type: FrameKind; command: DataKind;VAR f: frame);
  602. BEGIN
  603.         IF trace THEN BConOut(CON,"T") END;
  604.         f.kind:=type;
  605.         f.cmd:=command;
  606.         IF debug THEN cleartosend:=TRUE END; (* so we can send in loop *)
  607.         waitcts(TRUE);
  608.         IF trace THEN BConOut(CON,"1") END;
  609.         SFRAME:=f;
  610.         requesttosend:=TRUE;
  611.         waitcts(FALSE);
  612.         IF trace THEN BConOut(CON,"2") END;
  613.         IF SFRAME.kind=ack THEN cleartosend:=TRUE END;
  614. END     sendtoremote;
  615.  
  616. PROCEDURE ToHost(VAR f: frame);
  617. BEGIN
  618.         IF trace THEN BConOut(CON,"H") END;
  619.         IF f.kind=callreq THEN
  620.            framewaiting:=FALSE;
  621.            RETURN;
  622.         END;
  623.         IF f.kind=clearreq THEN
  624.            framewaiting:=FALSE;
  625.            RETURN;
  626.         END;
  627.         IF f.kind=diag THEN
  628.            framewaiting:=FALSE;
  629.            RETURN;
  630.         END;
  631.         IF f.kind=data THEN
  632.            IF f.cmd=rdmediareq THEN
  633.         IF trace THEN BConOut(CON,"M") END;
  634.               framewaiting:=FALSE;
  635.               nframe2.d0:=LONGCARD(MediaChange(CARDINAL(f.d0)));
  636.               sendtoremote(data,rdmediaconf,nframe2);
  637.               RETURN;
  638.            END;
  639.            IF f.cmd=rdbpbreq THEN
  640.         IF trace THEN BConOut(CON,"P") END;
  641.               framewaiting:=FALSE;
  642.               nframe2.d0:=LONGCARD(GetBPB(CARDINAL(f.d0)));
  643.               bpbptr:=ADDRESS(nframe2.d0);
  644.               nbpbptr:=ADR(nframe2.info);
  645.               FOR i:=0 TO TSIZE(BPB)-1 DO
  646.                   nbpbptr^[i]:=bpbptr^[i];    
  647.               END;
  648.               sendtoremote(data,rdbpbconf,nframe2);
  649.               RETURN;
  650.            END;
  651.            IF f.cmd=rdrwabsreq THEN
  652.         IF trace THEN BConOut(CON,"W") END;
  653.               framewaiting:=FALSE;
  654.               nframe2.d0:=LONGCARD(RWAbs(RW(f.rw),ADR(f.info),1,f.recno,
  655.                                    CARDINAL(f.d0)));
  656.               IF (f.rw=0) OR (f.rw=2) THEN
  657.                  nframe2.rw:=f.rw;
  658.                  nframe2.info:=f.info; (* if rec get buffer to send *)
  659.               END;
  660.               sendtoremote(data,rdrwabsconf,nframe2);
  661.               RETURN;
  662.            END;
  663.         END;
  664. END     ToHost;
  665.  
  666. PROCEDURE senddata;
  667. BEGIN
  668.     SFRAME.seq:=C.nextframetosend;
  669.     SFRAME.ack:=1-C.frameexpected;
  670.     sendf(SFRAME);
  671.     IF SFRAME.kind#ack THEN
  672.        StartTimer; (* set timer to wait for frame ack from remote host *)
  673.     END;
  674. END     senddata;
  675.  
  676. PROCEDURE StartTimer;
  677. BEGIN
  678.         CODE(3f3cH,0017H,4e4eH,548fH); (* gettime *)
  679.         timestart:=LONGCARD(REGISTER(0));
  680.         timer:=TRUE;                      (* test *)
  681.         timefortimeout:=timestart;
  682.         IncTime(timefortimeout,1+(CARDINAL(C.speed)));
  683. END     StartTimer;
  684.  
  685. PROCEDURE IncTime(VAR t : LONGCARD; c: CARDINAL);
  686. BEGIN
  687.         IF c<1 THEN RETURN END;
  688.  
  689.         time:=t;
  690.         SETREG(0,time);
  691.         CODE(0280H,0,001FH);
  692.         sec:=LONGCARD(REGISTER(0));
  693.  
  694.         time:=t;
  695.         SETREG(0,time);
  696.         CODE(0280H,0,07E0H);
  697.         min:=LONGCARD(REGISTER(0));
  698.         min:=min DIV 32;
  699.  
  700.         time:=t;
  701.         SETREG(0,time);
  702.         CODE(0280H,0,0F800H);
  703.         hour:=LONGCARD(REGISTER(0));
  704.         hour:=hour DIV 2048;
  705.  
  706.         WHILE c#0 DO
  707.               sec:=sec+1;
  708.               c:=c-1;
  709.  
  710.               IF sec>29 THEN
  711.                  sec:=sec-30;
  712.                  min:=min+1;
  713.               END;
  714.  
  715.               IF min>59 THEN
  716.                  min:=min-60;
  717.                  hour:=hour+1;
  718.               END;
  719.  
  720.               IF hour>23 THEN
  721.                  hour:=hour-24;
  722.               END;
  723.         END; (* while *)
  724.         t:=0;
  725.         t:=sec;
  726.         t:=t+(min*32);
  727.         t:=t+(hour*2048);
  728. END     IncTime;
  729.  
  730. PROCEDURE TimeOut(): BOOLEAN;
  731. BEGIN
  732.         IF (NOT timer) THEN RETURN FALSE END;
  733.         CODE(3f3cH,0017H,4e4eH,548fH); (* gettime *)
  734.         timeouttime:=LONGCARD(REGISTER(0));
  735.         SETREG(0,timeouttime);
  736.         CODE(0280H,0,0FFFFH);
  737.         timeouttime:=LONGCARD(REGISTER(0));
  738.         IF timeouttime>timefortimeout THEN
  739.            StartTimer;
  740.            RETURN TRUE;
  741.         END;
  742.         RETURN FALSE;
  743. END     TimeOut;
  744.  
  745. PROCEDURE Nwait(VAR e: evtype);
  746. BEGIN
  747.  
  748.          IF requesttosend AND cleartosend THEN
  749.             e:=hostready;
  750.             requesttosend:=FALSE;
  751.             cleartosend:=FALSE;
  752.             RETURN;
  753.          END;
  754.  
  755.          IF C.sendreset THEN
  756.             e:=reset;
  757.          END;
  758.  
  759.          IF framebufferfull THEN
  760.            cksum:=0;
  761.            FOR i2:=0 TO recframesize-5 DO
  762.               cksum:=cksum+CARDINAL(rframeptr^[i2])
  763.            END;
  764.            IF (cksum=rframe.cksum) THEN
  765.               e:=framearrival;
  766.               INC(R);
  767.            ELSE
  768.               e:=cksumerr;
  769.               framebufferfull:=FALSE;
  770.         IF trace THEN BConOut(CON,"U") END;
  771.            END;
  772.            RETURN;
  773.          END;            
  774.          nrecframe;
  775.          IF TimeOut() THEN
  776.             e:=timeout; 
  777.             INC(R);
  778.          END;     (* so sorry no frame ack *) 
  779. END     Nwait;
  780.  
  781. PROCEDURE HandleEvents();
  782. BEGIN
  783.             IF event=hostready THEN
  784.                event:=nothing;
  785.         IF trace THEN BConOut(CON,"S") END;
  786.                senddata;
  787.             END;
  788.  
  789.             IF event=reset THEN
  790.         IF trace THEN BConOut(CON,"I") END;
  791.                SFRAME.kind:=resetreq;
  792.                senddata;
  793.                charcount:=0;
  794.                R:=0;
  795.                gotframe:=FALSE;
  796.                framebufferfull:=FALSE;
  797.                FOR d:=0 TO 5 DO
  798.                    gotmediach[d]:=FALSE;
  799.                    gotbpb[d]:=FALSE;
  800.                END;
  801.                C.nextframetosend:=0;
  802.                C.frameexpected:=0;
  803.                cleartosend:=TRUE;
  804.                requesttosend:=FALSE;
  805.                framewaiting:=FALSE;
  806.                timer:=FALSE;
  807.                C.sendreset:=FALSE;
  808.                event:=nothing;
  809.             END;
  810.  
  811.             IF event=framearrival THEN
  812.                event:=nothing;
  813.  
  814.                IF (rframe.kind=ack) OR (rframe.kind=resetreq) THEN
  815.                   framewaiting:=FALSE
  816.                END;
  817.         IF trace AND (NOT framewaiting) THEN BConOut(CON,"F") END;
  818.  
  819.                IF (NOT framewaiting) THEN getf(RFRAME) END; 
  820.                framebufferfull:=FALSE;
  821.  
  822.                IF (RFRAME.ack=C.nextframetosend) OR debug THEN
  823.         IF trace THEN BConOut(CON,"K") END;
  824.                   cleartosend:=TRUE;
  825.                   StartTimer;
  826.                   R:=0;
  827.                   timer:=FALSE;
  828.                   inc(C.nextframetosend);
  829.                END;
  830.  
  831.                IF (RFRAME.seq=C.frameexpected) OR debug THEN
  832.         IF trace THEN BConOut(CON,"E") END;
  833.                   IF RFRAME.kind#ack THEN (* try to exec command *)
  834.                      inc(C.frameexpected); 
  835.                      framewaiting:=TRUE;
  836.                      R:=0;
  837.                      ToHost(RFRAME);
  838.                   END;
  839.                END;
  840.                IF RFRAME.kind=resetreq THEN
  841.                   charcount:=0;
  842.                   gotframe:=FALSE;
  843.                   framebufferfull:=FALSE;
  844.                   C.nextframetosend:=0;
  845.                   C.frameexpected:=0;
  846.                   FOR d:=0 TO 5 DO
  847.                       gotmediach[d]:=FALSE;
  848.                       gotbpb[d]:=FALSE;
  849.                   END;
  850.                   cleartosend:=TRUE;
  851.                   requesttosend:=FALSE;
  852.                   framewaiting:=FALSE;
  853.                   timer:=FALSE;
  854.                   C.sendreset:=FALSE;
  855.                   event:=nothing;
  856.                END;
  857.             END;
  858.  
  859.         SFRAME.seq:=C.nextframetosend;
  860.         SFRAME.ack:=1-C.frameexpected;
  861.  
  862.         IF event=timeout THEN
  863.            event:=nothing;
  864.         IF trace THEN BConOut(CON,"R") END;
  865.            sendf(SFRAME);
  866.            framewaiting:=FALSE;
  867.         END;
  868. END     HandleEvents;
  869.  
  870. BEGIN   (* body of module *)
  871.   IF Initialise() THEN
  872.  
  873.     charcount:=0;
  874.     gotframe:=FALSE;
  875.     framebufferfull:=FALSE;
  876.     C.nextframetosend:=0;
  877.     C.frameexpected:=0;
  878.     FOR d:=0 TO 5 DO
  879.         gotmediach[d]:=FALSE;
  880.         gotbpb[d]:=FALSE;
  881.     END;
  882.     cleartosend:=TRUE;
  883.     requesttosend:=FALSE;
  884.     framewaiting:=FALSE;
  885.     timer:=FALSE;
  886.     C.sendreset:=FALSE;
  887.     event:=nothing;
  888.     C.networkactive:=TRUE;
  889.     SuperExec(PROC(InstallVectors)) ; (* install the NETWORK *)
  890.         Open("ANETWORK.INT",0,handle);
  891.         IF handle>0 THEN        (* if there is, load in init file *)
  892.            count:=TSIZE(consave);
  893.            GEMDOS.Read(handle,count,ADR(C));
  894.            OK:=Close(handle);
  895.            ConfigureRS232(C.speed,NONE,136,-1,-1,-1);
  896.         END;
  897.     WITH BasePageAddress^ DO
  898.     TermRes(CodeLen+BssLen+LONGCARD(CodeBase-ADDRESS(BasePageAddress)),0);
  899.     END;
  900.   END ;
  901. END NETWORK.
  902.